COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "VMAP"
C00003 00003	PROCEDURE HACK
C00005 00004	LWD←LOCATION(WD)
C00008 ENDMK
C⊗;
BEGIN "VMAP"

INTEGER TRUNCATE,ATTENUATE,NEGATE,CONTOUR;
INTEGER EOF,I,WD,LWD;
DEFINE N=63;
DEFINE MASK='377, OBPS=8,IBPS=6;
DEFINE CHN=1;

INTEGER ARRAY TABL[0:N];

REAL GAMMA;

DEFINE MAPADR='771000;

INTEGER PROCEDURE GAMFN(INTEGER I);
   BEGIN
   INTEGER M;
   M←1 LSH OBPS;
   RETURN(M*(I/M)↑GAMMA);
   END;

PROCEDURE MAPSET(INTEGER ARRAY TABL);
   BEGIN
   INTEGER WD;
   WD←1 LSH 35 + 1 LSH 17 + MAPADR LSH -1;
   USETO(CHN,LOCATION(WD));
   USETI(CHN,LOCATION(WD));
   ARRYOUT(CHN,TABL[0],N+1);
   END;
PROCEDURE HACK;
   BEGIN
   OWN INTEGER ARRAY SW10ST[0:20];
   OWN INTEGER V,I;

   SIMPLE PROCEDURE SWTEN;
      BEGIN
      V←TABL[0];
      FOR I←0 STEP 1 UNTIL N-1 DO TABL[I]←TABL[I+1];
      TABL[N]←V;
      WD←1 LSH 35 + 1 LSH 17 + MAPADR LSH -1;
      USETO(CHN,LWD);
      USETI(CHN,LWD);
      ARRYOUT(CHN,TABL[0],N+1);
      END;

      START_CODE
      LABEL SW10,DUN,SW10A,SW10B;

      HRLZI   1,'400003;
      HRRI    1,SW10;
      CALLI   1,'400003;
      JRST    DUN;

SW10: MOVEI   '17,ACCESS(SW10ST[1]);
      JRST    2,@SW10A; SW10A: SW10B; SW10B:
      PUSHJ   '17,SWTEN;
      CALLI   '400024;

DUN:  SKIP            ;
      END;

   WHILE INCHRS<0 DO CALL(1,"SLEEP");

   END;
LWD←LOCATION(WD);

OPEN(CHN,"ELF",'17,0,0,0,0,EOF);
GAMMA←1;
CONTOUR←ATTENUATE←TRUNCATE←0;
NEGATE←FALSE;

WHILE TRUE DO
   BEGIN
   STRING STR;
   INTEGER C;
   REAL X;

   OUTSTR("*");
   STR←INCHWL;
   C←LOP(STR);
   X←REALSCAN(STR,0);
   CASE C OF
      BEGIN
      ["G"] GAMMA←X;
      ["←"] CONTOUR←X;
      ["→"] ATTENUATE←X;
      ["T"] TRUNCATE←X;
      ["H"] HACK;
      ["-"] NEGATE←NOT(NEGATE)
      END;

   FOR I←0 STEP 1 UNTIL N DO
      BEGIN
      INTEGER V;
      V←I LSH (OBPS-IBPS);
      V←((V LSH CONTOUR) LAND MASK) LOR (V LSH (CONTOUR-OBPS));
      V←GAMFN(V);
      V←V LSH -ATTENUATE;
      V←V LAND (-1 LSH TRUNCATE);
      IF NEGATE THEN V←V XOR MASK;
      TABL[I]←V;
      END;

   MAPSET(TABL);
   END;

RELEASE(CHN);

END;